unit uFileSearch;

interface

uses sysutils, windows, Classes, Contnrs, dialogs;

type
  TCriterioDuplicidade=(cdNome, cdTamanho);
  TCriteriosDuplicidade=set of TCriterioDuplicidade;

  TArquivo=class
  protected
    intMarca:integer;
    procedure CopyFrom(sr:TSearchRec; Caminho:string);
    procedure Assign(Source:TArquivo);
  public
    intTime:Integer;
    intSize:Integer;
    intAttr:Integer;
    intName:TFileName;
    intExcludeAttr:Integer;
    intFindHandle:THandle;
    intFindData:TWin32FindData;

    Time:TDateTime;
    Caminho:string;
    CaminhoCompleto:string;
    Marca:integer;

    constructor Create(sr:TSearchRec; Caminho:string); overload;
    constructor Create; reintroduce; overload;
  end;

  TArquivos=class(TObjectList)
  private
    function GetItems(idx: integer): TArquivo;
  protected
    procedure SetaTotas_intMarca(Marca:integer);
  public
    property Items[idx:integer]:TArquivo read GetItems; default;
    constructor Create; reintroduce;
    destructor Destroy; override;
    function RemoveDuplicatas:integer;
    function Remove(CaminhoCompleto:string):boolean;
  end;

  TArquivoAgrupado=class(TArquivos)
  public
    NomeArquivo:string;
    function QtdItensComMarca(Marca:integer):integer;
  end;

  TGrupoArquivos=class(TObjectList)
  private
    function GetItems(idx: integer): TArquivoAgrupado;
  public
    property Items[idx:integer]:TArquivoAgrupado read GetItems; default;
    constructor Create; reintroduce;
    destructor Destroy; override;
  end;

  TProgressEvent=procedure(progresso, Total:integer; DescProcessamento:string; var Cancelar:boolean) of object;

  TFileSearch=class(TComponent)
  private
    fListaArqs:TArquivos;
    FBytesMargemTamanho: integer;
    FOnProgress: TProgressEvent;
    function GetItems(Idx: integer): TArquivo;
    procedure SetBytesMargemTamanho(const Value: integer);
    procedure SetOnProgress(const Value: TProgressEvent);
  public
    procedure LimpaPesquisa;
    function RealizaPesquisa(CaminhoInicial:string; Mascara:string='*.*';
                             PesquisaSubDiretorios:boolean=false; RemoverDosItens:boolean=false):integer;
    function ToString(ColocarCaminho:boolean):TStrings;

    function QtdItensComMarca(marcas:array of integer):integer;
    function Count:integer;

    property Items[Idx:integer]:TArquivo read GetItems; default;

    property BytesMargemTamanho:integer read FBytesMargemTamanho write SetBytesMargemTamanho;

    function ArquivosComDuplicidade(Criterios:TCriteriosDuplicidade;
                                    MarcasParaProcessar:array of integer;
                                    QtdKBytesInicial:integer=0):TGrupoArquivos;
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;

    property OnProgress:TProgressEvent read FOnProgress write SetOnProgress;
  end;

implementation

uses math;

{ TFileSearch }

function TFileSearch.GetItems(Idx: integer): TArquivo;
begin
     result:=fListaArqs.Items[Idx];
end;

function TFileSearch.RealizaPesquisa(CaminhoInicial:string; Mascara:string='*.*'; PesquisaSubDiretorios:boolean=false;
                    RemoverDosItens:boolean=false):integer;
   function intRealizaPesquisa(CaminhoInicial, Mascara:string; PesquisaSubDiretorios:boolean; Nivel:integer; RemoverDosItens:boolean):integer;
             //faReadOnly	Read-only files
             //faHidden	Hidden files
             //faSysFile	System files
             //faVolumeID	Volume ID files
             //faDirectory	Directory files
             //faArchive	Archive files
             //faAnyFile	Any file
             //TSearchRec = record
             //    Time: Integer;
             //    Size: Integer;
             //    Attr: Integer;
             //    Name: TFileName;
             //    ExcludeAttr: Integer;
             //    FindHandle: THandle;
             //    FindData: TWin32FindData;
             //end;
   var sr: TSearchRec;
       arq:TArquivo;
   begin
        result:=0;
        //******* inclui sub Diretorios ********
          if PesquisaSubDiretorios
          then begin
               if sysutils.FindFirst(IncludeTrailingPathDelimiter(CaminhoInicial)+'*.*', faDirectory+faHidden, sr) = 0
               then begin
                    try
                       repeat
                             if (sr.Name<>'.') and (sr.Name<>'..') and (sr.Name<>'...')
                                and    ((sr.Attr and faDirectory) = faDirectory)
                             then begin
                                  inc(result, intRealizaPesquisa(IncludeTrailingPathDelimiter(CaminhoInicial)+sr.Name, Mascara, PesquisaSubDiretorios, Nivel+1, RemoverDosItens) );
                                  //showmessaGE(IncludeTrailingPathDelimiter(CaminhoInicial)+sr.Name);
                             end;
                       until sysutils.FindNext(sr) <> 0;
                    finally sysutils.FindClose(sr); end;
               end;
          end;
        //fim ******* inclui sub Diretorios ********

        if sysutils.FindFirst(IncludeTrailingPathDelimiter(CaminhoInicial)+Mascara, faAnyFile, sr) = 0
        then try
                repeat
                      if     not((sr.Attr and faDirectory) = faDirectory)
                         and not((sr.Attr and faVolumeID)  = faVolumeID)
                      then begin
                           arq:=TArquivo.Create(sr, CaminhoInicial);
                           if RemoverDosItens
                           then begin
                                if self.fListaArqs.Remove(arq.CaminhoCompleto)
                                then dec(result);
                                arq.free;
                           end
                           else begin
                                self.fListaArqs.Add( arq );
                                inc(result);
                           end;
                      end;
                until sysutils.FindNext(sr) <> 0;
             finally sysutils.FindClose(sr); end;
   end;
begin
     result:=intRealizaPesquisa(CaminhoInicial, Mascara, PesquisaSubDiretorios,0, RemoverDosItens);
     if not(RemoverDosItens) then result:=result-self.fListaArqs.RemoveDuplicatas;
end;

procedure TFileSearch.LimpaPesquisa;
begin
     self.fListaArqs.Clear;
end;

function TFileSearch.ToString(ColocarCaminho: boolean): TStrings;
begin
result:=nil; //verrr
end;

constructor TFileSearch.Create(AOwner: TComponent);
begin
     inherited;
     FOnProgress:=nil;
     FBytesMargemTamanho := 50;
     fListaArqs:=TArquivos.Create;
end;

destructor TFileSearch.Destroy;
begin
     fListaArqs.Free;
     inherited;
end;

function TFileSearch.Count: integer;
begin
     result:=Self.fListaArqs.Count;
end;

function TFileSearch.ArquivosComDuplicidade(
             Criterios:TCriteriosDuplicidade;
             MarcasParaProcessar:array of integer;
             QtdKBytesInicial:integer=0):TGrupoArquivos;
//         function FazBuff(arq:string; QtdBytes:integer; var TamBuf:integer):pByteArray;
//         var fs1:TFileStream;
//         begin
//              fs1:=TFileStream.Create(arq,fmOpenRead);
//              try
//                 fs1.Position:=0;
//                 GetMem(result,QtdBytes);
//                 TamBuf:=fs1.Read(result^, QtdBytes);
//              finally fs1.free; end;
//         end;
         procedure PreencheBuff(var BufArq1:pByteArray; TamBufArq1:integer; Arq:string; var QtdLido:integer);
         var fs1:TFileStream;
         begin
              fs1:=TFileStream.Create(arq,fmOpenRead);
              try
                 fs1.Position:=0;
                 QtdLido:=fs1.Read(BufArq1^, TamBufArq1);
              finally fs1.free; end;
         end;
         function ConteudoIgual(bufArq1:pByteArray; LidoBuf1:integer; arq2:string; BufArq2:pByteArray; TamBufArq2:integer):boolean; overload;
         var fs2:TFileStream;
             i, t2:integer;
         begin
              result:=true;
              fs2:=TFileStream.Create(arq2,fmOpenRead);
              try
                 fs2.Position:=0;
                 t2:=fs2.Read(BufArq2^, TamBufArq2);
                 for i:=0 to min(LidoBuf1,t2)-1 do
                     if bufArq1^[i]<>BufArq2^[i]
                     then begin result:=false; break; end;
              finally fs2.free; end;
         end;

//         function ConteudoIgual(bufArq1:pByteArray; TambufArq1:integer; arq2:string; QtdBytesComparacao:integer):boolean; overload;
//         var fs2:TFileStream;
//             buf2:pByteArray;
//             i, t2:integer;
//         begin
//              result:=true;
//              fs2:=TFileStream.Create(arq2,fmOpenRead);
//              try
//                 fs2.Position:=0;
//                 GetMem(buf2,QtdBytesComparacao);
//                 try
//                    t2:=fs2.Read(buf2^, QtdBytesComparacao);
//                    for i:=0 to min(TamBufArq1,t2)-1 do
//                        if bufArq1^[i]<>buf2^[i]
//                        then begin result:=false; break; end;
//                 finally
//                   freemem(buf2,QtdBytesComparacao);
//                 end;
//              finally fs2.free; end;
//         end;
//         function ConteudoIgual(a1, a2:string; QtdBytesComparacao:integer):boolean; overload;
//         var fs1, fs2:TFileStream;
//             buf1,buf2:pByteArray;
//             i, l1, l2:integer;
//         begin
//              result:=true;
//              fs1:=TFileStream.Create(a1,fmOpenRead);
//              try
//                 fs2:=TFileStream.Create(a2,fmOpenRead);
//                 try
//                    fs1.Position:=0; fs2.Position:=0;
//                    GetMem(buf1,QtdBytesComparacao);
//                    GetMem(buf2,QtdBytesComparacao);
//                    try
//                       l1:=fs1.Read(buf1^, QtdBytesComparacao);
//                       l2:=fs2.Read(buf2^, QtdBytesComparacao);
//                       for i:=0 to min(l1,l2)-1 do
//                           if buf1^[i]<>buf2^[i]
//                           then begin result:=false; break; end;
//                    finally
//                      freemem(buf1,QtdBytesComparacao);
//                      freemem(buf2,QtdBytesComparacao);
//                    end;
//                 finally fs2.free; end;
//              finally fs1.free; end;
//         end;
var i,j, k:integer;
    Garq:TArquivoAgrupado;
    arq:TArquivo;
    igual:boolean;
    BufArq1, BufArq2:pByteArray;
    TamBufArq1, LidoBufArq1, TamBufArq2:integer;
    Cancelar, NaoProcessar:boolean;
begin
     result:=TGrupoArquivos.Create;
     Cancelar:=false;
     fListaArqs.SetaTotas_intMarca(0); //identifica como nao processados...

     BufArq1:=nil; BufArq2:=nil;
     if QtdKBytesInicial>0
     then begin
          TamBufArq1:=QtdKBytesInicial*1024;
          GetMem(BufArq1,TamBufArq1);
          TamBufArq2:=QtdKBytesInicial*1024;
          GetMem(BufArq2,TamBufArq2);
     end;
     try
        for i:=0 to fListaArqs.count-1 do
        begin
             NaoProcessar:=true;
             for k:=0 to high(MarcasParaProcessar) do
                 if fListaArqs[i].Marca=MarcasParaProcessar[k]
                 then begin NaoProcessar:=false; break; end;
             if NaoProcessar then continue;

             LidoBufArq1:=-1;
             Garq:=nil;
             for j:=i+1 to fListaArqs.count-1 do
             begin
                  NaoProcessar:=true;
                  for k:=0 to high(MarcasParaProcessar) do
                      if fListaArqs[j].Marca=MarcasParaProcessar[k]
                      then begin NaoProcessar:=false; break; end;
                  if not(NaoProcessar)
                  then NaoProcessar:=fListaArqs[j].intMarca=1; //Jah processado
                  if NaoProcessar then continue;

                  igual:=true;
                  if igual and (cdNome in Criterios)
                  then igual:=(UpperCase(fListaArqs[i].intName)=UpperCase(fListaArqs[j].intName));

                  if igual and (cdTamanho in Criterios)
                  then igual:=( abs(fListaArqs[i].intSize-fListaArqs[j].intSize)<=self.FBytesMargemTamanho );

                  if igual and (QtdKBytesInicial>0)
                  then begin
                       if (LidoBufArq1<0)
                       then PreencheBuff(BufArq1, TamBufArq1, fListaArqs[i].CaminhoCompleto, LidoBufArq1);
                       igual:=ConteudoIgual(BufArq1, LidoBufArq1,
                                            fListaArqs[j].CaminhoCompleto, BufArq2, TamBufArq2);
                  end;

                  if igual
                  then begin
                       fListaArqs[j].intMarca:=1; //marca como jah processado
                       if not(Assigned(Garq))
                       then begin
                            arq:=TArquivo.Create;
                            arq.Assign(fListaArqs[i]);
                            Garq:=TArquivoAgrupado.Create;
                            Garq.NomeArquivo:=fListaArqs[i].intName;
                            Garq.Add(arq);
                            result.Add(Garq);
                       end;
                       arq:=TArquivo.Create;
                       arq.Assign(fListaArqs[j]);
                       Garq.Add(arq);
                  end;
             end;
             if Assigned(FOnProgress)
             then begin
                  FOnProgress(i+1, fListaArqs.count, fListaArqs[i].CaminhoCompleto, Cancelar);
                  if Cancelar then break;
             end;
        end;
     finally
        if Assigned(BufArq1) then freemem(BufArq1, tamBufArq1);
        if Assigned(BufArq2) then freemem(BufArq2, tamBufArq2);
     end;
end;

procedure TFileSearch.SetBytesMargemTamanho(const Value: integer);
begin
  FBytesMargemTamanho := Value;
end;

procedure TFileSearch.SetOnProgress(const Value: TProgressEvent);
begin
     FOnProgress := Value;
end;

function TFileSearch.QtdItensComMarca(marcas: array of integer): integer;
var i,j:integer;
begin
     result:=0;
     for i:=0 to self.Count-1 do
         for j:=0 to high(marcas) do
             if self.Items[i].Marca=Marcas[j]
             then begin inc(result); break; end;
end;

{ TArquivo }

procedure TArquivo.Assign(Source: TArquivo);
begin
     self.intTime:=source.intTime;
     self.intSize:=source.intSize;
     self.intAttr:=source.intAttr;
     self.intName:=source.intName;
     self.intExcludeAttr:=source.intExcludeAttr;
     self.intFindHandle:=source.intFindHandle;
     self.intFindData:=source.intFindData;
     self.Time:=source.Time;
     self.Caminho:=source.Caminho;
     self.CaminhoCompleto:=source.CaminhoCompleto;
     //self.fListaCaminhos.Assign(source.fListaCaminhos);
end;

procedure TArquivo.CopyFrom(sr: TSearchRec; Caminho:string);
begin
     self.intTime:=sr.Time;
     self.intSize:=sr.Size;
     self.intAttr:=sr.Attr;
     self.intName:=sr.Name;
     self.intExcludeAttr:=sr.ExcludeAttr;
     self.intFindHandle:=sr.FindHandle;
     self.intFindData:=sr.FindData;
     self.Time:=FileDateToDateTime(self.intTime);
     self.Caminho:=IncludeTrailingPathDelimiter(Caminho);
     self.CaminhoCompleto:=self.Caminho+self.intName;
end;

constructor TArquivo.Create(sr: TSearchRec; Caminho:string);
begin
     self.Create;
     self.CopyFrom(sr, Caminho);
end;

constructor TArquivo.Create;
begin
     inherited;
     Marca:=0;
     intMarca:=0;
end;

{ TArquivos }

constructor TArquivos.Create;
begin
     inherited Create(true);
end;

destructor TArquivos.Destroy;
begin
     self.Clear;
     inherited;
end;

function TArquivos.GetItems(idx: integer): TArquivo;
var x:TObject;
begin
     x:=inherited items[idx];
     result:=TArquivo(x);
end;

function TArquivos.Remove(CaminhoCompleto: string): boolean;
var i:integer;
begin
     result:=false;
     for i:=0 to self.Count-1 do
         if UpperCase(self.Items[i].CaminhoCompleto)=UpperCase(CaminhoCompleto)
         then begin
              result:=true;
              self.Delete(i);
              break;
         end;
end;

function TArquivos.RemoveDuplicatas: integer;
var i,j:integer;
begin
     result:=0;
     i:=0;
     while i<self.Count do
     begin
          j:=i+1;
          while j<self.Count do
          begin
               if UpperCase(self.Items[i].CaminhoCompleto)=
                  UpperCase(self.Items[j].CaminhoCompleto)
               then begin inc(result); self.Delete(j); end
               else inc(j);
          end;
          inc(i);
     end;
end;

procedure TArquivos.SetaTotas_intMarca(Marca: integer);
var i:integer;
begin
     for i:=0 to self.Count-1 do
         self.Items[i].intMarca:=Marca;
end;

{ TGrupoArquivos }

constructor TGrupoArquivos.Create;
begin
     inherited Create(true);
end;

destructor TGrupoArquivos.Destroy;
begin
     self.Clear;
     inherited;
end;

function TGrupoArquivos.GetItems(idx: integer):TArquivoAgrupado;
var x:TObject;
begin
     x:=inherited items[idx];
     result:=TArquivoAgrupado(x);
end;

{ TArquivoAgrupado }

function TArquivoAgrupado.QtdItensComMarca(Marca: integer): integer;
var i:integer;
begin
     result:=0;
     for i:=0 to self.Count-1 do
         if self.Items[i].Marca=Marca then inc(result);
end;

end.
